year <- lubridate::year(Sys.Date())
week <- lubridate::week(Sys.Date())
plots_dir <- paste0("plots/", year, "-", week)
fs::dir_create(plots_dir)
png_file <- "2022-25_Juneteenth.png"
pdf_file <- "2022-25_Juneteenth.pdf"
## packages
library(tidyverse)
library(janitor)
library(scales)
library(ggtext)
library(patchwork)
library(showtext)
font_add_google(name = "IBM Plex Sans", family = "ibm-plex-sans")
showtext_opts(dpi = 300)
showtext_auto(enable = TRUE)
tuesdata <- tidytuesdayR::tt_load(year, week = week)
## --- Compiling #TidyTuesday Information for 2022-06-21 ----
## --- There are 6 files available ---
## --- Starting Download ---
## 
##  Downloading file 1 of 6: `african_names.csv`
##  Downloading file 2 of 6: `slave_routes.csv`
##  Downloading file 3 of 6: `blackpast.csv`
##  Downloading file 4 of 6: `firsts.csv`
##  Downloading file 5 of 6: `science.csv`
##  Downloading file 6 of 6: `census.csv`
## --- Download complete ---
firsts <- tuesdata$firsts

# blackpast <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/blackpast.csv')
# census <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/census.csv')
# slave_routes <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/slave_routes.csv')
# african_names <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/african_names.csv')
firsts %>%
  count(category)
## # A tibble: 8 × 2
##   category                 n
##   <chr>                <int>
## 1 Arts & Entertainment   107
## 2 Education & Science     87
## 3 Law                     14
## 4 Military                73
## 5 Politics                82
## 6 Religion                21
## 7 Social & Jobs           57
## 8 Sports                  38
firsts_tbl <- firsts %>%
  filter(year > 1799) %>% 
  filter(year < 1900) %>% 
  mutate(person = str_replace_all(person, "\\[[0-9]+\\]", ""),
         person = str_replace_all(person, "\\[Note [0-9]+\\]", ""),
         person = str_remove(person, " \\(See also"),
         person = str_remove(person, ", renamed Lincoln University.+$"),
         person = str_remove(person, ", who was educated at the University.+$"),
         person = str_remove(person, ", based in Philadelphia.+$"),
         person = str_remove(person, " founded in Philadelphia.+$"),
         person = str_remove(person, ", Belgium.+$"),
         person = str_remove(person, ", The Laughing.+$"),
         person = str_remove(person, ", hired by.+$"),
         person = str_remove(person, " His opponent contested.+$"),
         person = str_remove(person, ", then living.+$"),
         person = str_remove(person, "; Xenia.+$"),
         person = str_remove(person, "founded in New York City by "),
         person = str_replace_all(person, " \\(.+\\)", ""),
         person = str_remove(person, "\\.$"),
         accomplishment = str_remove(accomplishment, "First African-American"),
         accomplishment = str_remove(accomplishment, "^First "),
         accomplishment = str_remove(accomplishment, "African-American "),
         accomplishment = str_replace(accomplishment, "woman", "female")
         ) %>% 
  group_by(year) %>% 
  sample_n(1)
black <-        "#000000"
brown <-    "#654321"
tan     <-      "#d2b48c"
gold    <-  "#ffd700"
pink    <-      "#ffc0cb"
crimson <-      "#dc143c"
green <-        "#00aa00"
blue    <-      "#4682b4"

fill_cols <- c(
  "Religion" = crimson,
  "Education & Science" = brown,
  "Law" = blue,
  "Military" = green,
  "Politics" = black,
  "Social & Jobs" = pink,
  "Sports" = gold,
  "Arts & Entertainment" = tan
)

subtitle <- "FIRST AFRICAN-AMERICAN ..."
title <-
  "African-American accomplishments in the nineteenth century"
caption <- "Source: adapted from Wikipedia"

plt_1 <-
  firsts_tbl %>%
  ggplot() +
  geom_hline(aes(yintercept = 0), linetype = 2) +
  geom_label(
    aes(
      x = year,
      y = 0,
      label = year,
      fill = category
    ),
    color = "white",
    label.r = unit(0.5, "lines"),
  ) +
  scale_fill_manual(values = fill_cols) +
  geom_text(aes(x = year, y = .5, label = person),
            hjust = "left",
            size = 4) +
  geom_text(aes(x = year, y = -.5, label = accomplishment),
            hjust = "right",
            size = 4) +
  scale_x_reverse() +
  scale_y_continuous(limits = c(-5, 5)) +
  labs(
    title = title,
    subtitle = subtitle,
    caption = caption,
    x = NULL,
    y = NULL
  ) +
  coord_flip() +
  theme_minimal() +
  theme(
    text = element_text(family = "ibm-plex-sans"),
    plot.title = element_text(
      family = "ibm-plex-sans",
      size = 20,
      hjust = 0.5
    ),
    plot.subtitle = element_text(
      family = "ibm-plex-sans",
      face = "bold",
      size = 28,
      hjust = 0.5
    ),
    axis.text = element_blank(),
    axis.line = element_blank(),
    panel.grid = element_blank(),
    plot.background = element_rect(fill = "#ede5dc"),
    legend.position = "bottom"
  )
plt_1 + plot_layout(ncol = 1)
ggsave(here::here(plots_dir, pdf_file),
      width = 12, height = 20, dpi = 300,
      device = cairo_pdf)

ggsave(here::here(plots_dir, png_file),
      width = 12, height = 20, dpi = 300,
      device = "png")

sessionInfo()
## R version 4.2.0 (2022-04-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Linux Mint 20.3
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=nl_NL.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=nl_NL.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=nl_NL.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] showtext_0.9-5  showtextdb_3.0  sysfonts_0.8.8  patchwork_1.1.1
##  [5] ggtext_0.1.1    scales_1.2.0    janitor_2.1.0   forcats_0.5.1  
##  [9] stringr_1.4.0   dplyr_1.0.9     purrr_0.3.4     readr_2.1.2    
## [13] tidyr_1.2.0     tibble_3.1.7    ggplot2_3.3.6   tidyverse_1.3.1
## 
## loaded via a namespace (and not attached):
##  [1] tidytuesdayR_1.0.2 httr_1.4.3         sass_0.4.1         bit64_4.0.5       
##  [5] vroom_1.5.7        jsonlite_1.8.0     here_1.0.1         modelr_0.1.8      
##  [9] bslib_0.3.1        assertthat_0.2.1   highr_0.9          selectr_0.4-2     
## [13] cellranger_1.1.0   yaml_2.3.5         pillar_1.7.0       backports_1.4.1   
## [17] glue_1.6.2         digest_0.6.29      gridtext_0.1.4     rvest_1.0.2       
## [21] snakecase_0.11.0   colorspace_2.0-3   htmltools_0.5.2    pkgconfig_2.0.3   
## [25] broom_0.8.0        haven_2.5.0        tzdb_0.3.0         generics_0.1.2    
## [29] farver_2.1.0       usethis_2.1.6      ellipsis_0.3.2     withr_2.5.0       
## [33] cli_3.3.0          magrittr_2.0.3     crayon_1.5.1       readxl_1.4.0      
## [37] evaluate_0.15      fs_1.5.2           fansi_1.0.3        xml2_1.3.3        
## [41] tools_4.2.0        hms_1.1.1          lifecycle_1.0.1    munsell_0.5.0     
## [45] reprex_2.0.1       compiler_4.2.0     jquerylib_0.1.4    rlang_1.0.2       
## [49] grid_4.2.0         rstudioapi_0.13    labeling_0.4.2     rmarkdown_2.14    
## [53] gtable_0.3.0       DBI_1.1.2          curl_4.3.2         R6_2.5.1          
## [57] lubridate_1.8.0    knitr_1.39         fastmap_1.1.0      bit_4.0.4         
## [61] utf8_1.2.2         rprojroot_2.0.3    stringi_1.7.6      parallel_4.2.0    
## [65] Rcpp_1.0.8.3       vctrs_0.4.1        dbplyr_2.2.0       tidyselect_1.1.2  
## [69] xfun_0.31